C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANZ,RAND AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /INS/ INST(27),BG(60)
C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
C   F1=86  F15=100 (NO F16!)

	COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
C  SEE LABEL 1774 AND ABOVE RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),PCH(27,32),
	1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
	1 ,P1(27),JFM(4),COPY(30),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/2000/
	1, JFM(3)/','/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/
	1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
	CALL RNDINT
C  INIT RAND NUM GENERATOR.
CC    PR=0  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
      TP=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,32    
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TYPE 8002
1112	ACCEPT 77732,JNP
	JFM(4)='5F)'
	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,K,TF,AMPFAC,OP1,DURX
C  JFM IS THE CURRENT FORMAT STATEMENT
	IF(K.NE.'EDIT')GO TO 3112
	JED=0
	GO TO 2112
C  'E(DIT)' GOES TO EDIT MODE
3112	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
21122	IF(K.NE.'TYPE')GO TO 128
	ITYP=0
	DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
	IFLNM='FOR21'
	REWIND 21
	GO TO 3127
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(K.EQ.'INFO')GO TO 1280
	IF(K.NE.'HELP')GO TO 3128
1280	TYPE 8002
	TYPE 1113
	TYPE 118
	TYPE 1114
	TYPE 8002
	GO TO 1112
118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT('     NAME  TF  AMPFAC  OMIT"  DUR"'/)
1114	FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
	1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
	1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)

3128	IF(K.NE.IBLA)IFLNM=K
	CALL IFILE(1,IFLNM)
	READ(1,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
	REREAD 8001,K
	IF(K.NE.'COMME')GO TO 3000
3001	READ(1,77732)JNP
	IF(JNP(3).NE.ISEMI)GO TO 3001
	GO TO 3127
C  TO READ HEADER OF 'ET' FILES
3000	REWIND 1
	CALL IFILE(1,IFLNM)

CC3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TYPE 118
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	ACCEPT 300,MX,X,Y,Z
	IF(MX.NE.99)GO TO 6127
	TYPE FINM
	ACCEPT 8001,ISLAC
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(X.NE.0)IXIN=X
C   MX=3 GIVES DURS ONLY
C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
	MZ=0
	JOUT=5
C  5=OUTPUT TO TTY
	SOS=-1.
	IF(Y.NE.0)SOS=0  
C  IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
	IF(MX.NE.22)GO TO 2107
CC	JOUT=3
C DIRECT TO LPT AT COLGATE 6/74
	JOUT=22
	REWIND 22
2107	IF(MX.LE.1)MX=MX-2
	IF(MX.EQ.-2)GO TO 77
	IF(MX.EQ.2)GO TO 77
	IF(MX.NE.22)GO TO 177
77	MZ=-1
177	IF(MX.EQ.4)MZ=-4
      CALL READIT
      END
	SUBROUTINE READIT
	COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
	COMMON/VV/LIMIT, V(1) /A/ ROFF(27),NP(27),PCH(27,32),
	1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
	1 ,P1(27),JFM(4),COPY(30),IFM(80)
	0
,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION IV(1),LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (VX1,VX(1)),(JNP,INP1,INP(1)),(IPP,ISCA(2))
	1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
	1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
	1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
	1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
C   *************** READS INPUT  ***********************
	KIMIT=LIMIT-100
C  FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
2308	IF(ITYP)GO TO 2127
	DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
	1,TEDIT/20H(' RETYPE LINE?'/  )/,IEN/'N'/,ITMPO/'TEMPO'/
23081	TYPE TINST
	ACCEPT 77732,JNP
77732	FORMAT(80A1)
CC	IF(JED)WRITE(21,77732)INP
	IF(JED)CALL COLTTY(JNP,21)
	JFM(4)='80A1)'
C  PUTS ON LPT AND TTY
	GO TO 1074
CC 6/74 COLGATE2127	JREAD=1
CC 6/74 COLGATE 4400	READ(1,77732,END=2337)JNP
2127	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
CC  SEE END OF PG.6	IF(SOS)WRITE(JOUT,87732)INP
CC 7/74	IF(SOS)CALL COLTTY(JNP,JOUT,3)
CC 6/74  COLGATE 	GO TO(441,442,443,444,445,446)JREAD

441	JFM(4)='80A1)'
	IF(LN.EQ.0)GO TO 1074
CC	REREAD 2114,LN,JNP
C****  READS ONLY FILES WITH LINE NUMBERS!
	JFM(1)=' (I,A'
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,LN,J,JNP
	GO TO 4127
1074	JFM(1)='   (A'
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,J,JNP
4127	IF(JED)GO TO 41271
	IF(K.EQ.'Y')GO TO 41271
C  K CHECK IS TO PASS AFTER RETYPING
	TYPE TEDIT
	ACCEPT 77732,K
	IF(K.EQ.'Y')GO TO 23081
	IF(K.EQ.IG)JED=-1


41271	IF(J.EQ.IBLA)GO TO 2308
	MLX=1
	IZ=0
	JA=-1
	ISUB=4
	CALL CLEAN(INP,LEND)
C  CLEANS OUT = AND , AND FINDS LINE LENGTH.
	ALL=1.
	VX1=0
	VX2=0
	VX3=0
	LK=-1
	K=0
	IF(V(I-1).NE.-9900.-BY)GO TO 364
	BY=-1.
	I=I-1
364	DO 361 JD=1,LEND
	N=INP(JD)
	IF(N.NE.'R')GO TO 361
C  LOOKS FOR 'RESTART'
	DO 3611 M=JD,LEND
	KL=INP(M)
	IF(KL.EQ.IBLA)GO TO 3631
	IF(KL.EQ.ISEMI)GO TO 3631
CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
3611	INP(M)=IBLA
C   CHANGES 'RESTART' TO BLANKS
3631	DO 363 N=1,NINS
	IF(J.NE.INST(N))GO TO 363
	IQ(N)=-1
C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
	GO TO 362
363	CONTINUE
361	IF(N.EQ.ISEMI)GO TO 6773
6773	K=K+1
	IF(K.GT.NINS)GO TO 36
	IF(INST(K).NE.J)GO TO 6773
	IF(IQ(K).EQ.-1)GO TO 6773
C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
	LK=K
	GO TO 1773
36	IF(J.EQ.'RUN;')GO TO 197
	IF(J.NE.'RUN')GO TO 97
197	CALL RUNIT
97	IF(J.EQ.'INSER')GO TO 397
	IF(J.NE.'EDIT')GO TO 297
397	ISUB=6  
297	IF(ISUB.GT.4)GO TO 1773
	IF(J.EQ.ITMPO)GO TO 1773
	IF(J.EQ.'CONDU')GO TO 1773
	IF(J.EQ.'PLAY')GO TO 1773
	IF(J.EQ.'SECTI')GO TO 1081
C******************  ABOVE AND BELOW FOR 'SECTIONS'
	IF(J.EQ.'END')GO TO 1082
	IF(J.EQ.'END S')GO TO 1082
	IF(J.EQ.'FINIS')GO TO 1082
362	LK=NINS+1
	IF(LK.GT.KZY)CALL ERR(LN)
	INST(LK)=J
	IZ=LK
	GO TO 1773

C*********** DOWN TO 8001 FOR 'SECTIONS'
1083	V(I)=-99.
	KL=1
	GO TO 3083
C  READS 'PLAY SECT. N1,N2'
1081	V(I)=-199.
	KL=4
3083	DO 2081 K=KL,72
C******  OR 80 ↑↑↑↑↑↑↑↑↑ ?????
	IF(INP(K).EQ.IBLA)GO TO 2081
	IV(I+1)=INP(K)
	I=I+2
3081	BY=-1.
	GO TO 2308
2081	CONTINUE
C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
C********* FEB 15,71
1082	V(I)=-299.
	I=I+1
	GO TO 3081
C   MARKS END OF SECTION
C************************

8001	FORMAT(A5,5F)
107	FORMAT(I,A5,5F)
4	IF(LK.LE.NINS)GO TO 8773
	IF(ALL.GT.0)GO TO 1004
	IF(IDALL.GT.0)GO TO 8773
	BG(LK)=VX1
	IDALL=LK
	GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004	BG(LK)=VX1
	IF(LK.EQ.IZ)VX1=0
C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C   CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004	NINS=LK
	IF(VX3.NE.0)VX2=10000.+VX3
	IF(VX2.EQ.0)VX2=-1
	DUR(LK)=VX2
	GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
900	IF(VX1.NE.BY)GO TO 497
	IF(J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
497	BY=VX1
C  BY=CURRENT BG TIME.
	V(I)=-9900.-BY
	I=I+1
	IF(NWZ.NE.0)CALL BGSORT(BY)
5773	IF(J.EQ.ITMPO)GO TO 1106
	IF(J.EQ.'CONDU')GO TO 3018
	IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'


4773	NW=LPAR
CZZZZZZZ	MLX=ML
	ML=MLX
	IF(I.LT.KIMIT)GO TO 774
	TYPE 107,I
	IF(I.GE.LIMIT)TYPE 1774
1774	FORMAT(/' ******* TOO MUCH INPUT DATA!! *******'/)
774	ALL=1.
	DF=0
	ISUB=1
CXXX	IF(MLX.LT.LEND)GO TO 17732
CXXX THIS LOST ON );Px . . . ;  TAKEN OUT 8/20/76
CXXX	GO TO 7773

CZZZZZZZZZZZZZZZZZZZZZZZZ
1299	IF(MLX.LE.LEND)GO TO 1773
CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ


7773	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
	IF(INP1.EQ.IBLA)GO TO 7773
	IF(JED)GO TO 77733
	TYPE TEDIT
	ACCEPT 77732,K
	IF(K.NE.'Y')GO TO 442
	TYPE TPALN
	ACCEPT 77732,JNP
442	IF(K.EQ.IG)JED=-1
C   DOESN'T WORK FOR EDITS AND INSERTS YET???


77733	MLX=1
C  FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
C   'LISTS' MUST END WITH ; IN NEW(7/74) VERSION. 
	CALL CLEAN(INP,LEND)
1773	IF(IPRN.EQ.0)GO TO 17732
	L=I-1
	IF(QTS.GE.0)GO TO 597
	IF(V(I-1).EQ.999.)L=L-1
597	IPRN=IPRN-1
	IF(PARENS.EQ.0)GO TO 17733
	PARENS=0
	LIST(LCNT+2)=L
	LCNT=LCNT+3
	IF(IPRN.EQ.0)GO TO 17732
	IPRN=0
17733	LIST(MOT)=L
	MOT=0
C   FOR ERROR TRAP

CC17732	JZ=0
17732	N=0
17731	ML=MLX

C   BIG LOOP -- TO END OF PAGE 1.
	JD=ML
975	N=INP(JD)
	IF(N.EQ.IBLA)GO TO 236
CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
33611	IF(N.EQ.'(')GO TO 697
	IF(N.NE.')')GO TO 2361
697	INP(JD)=IBLA
	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.')')GO TO 3361
	IF(PARENS.EQ.0)GO TO 1140
	LCNT=LCNT+3
	IF(MOT.NE.0)CALL ERR(3)
	MOT=LCNT-1
1140	DO 11401 JC=1,LCNT-1,3
	IF(INP(L).NE.LIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
	TYPE 11402,INP(L)
	CALL EXIT

11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
11401	CONTINUE
	LIST(LCNT)=INP(L)
	PARENS=-1.
	INP(L)=IBLA
	LIST(LCNT+1)=I
	GO TO 236
C ''''''' FOR SINGLE QUOTES
3361	IPRN=IPRN+1
	GO TO 236
C  JUMPS BACK INTO QUOTE SECTION
CQ	IF(PARENS.EQ.0)GO TO 2140
CQ	LIST(LCNT+2)=L
CQ	LCNT=LCNT+3
CQ	PARENS=0
CQ	GO TO 33612
CQ2140	LIST(MOT)=L
CQ	GO TO 33612
CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
2361	IF(N.NE.'@')GO TO 5361
	DO 113 L=1,LEND
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.'-')GO TO 6113
	RETRO=0
	INP(K)=IBLA
	GO TO 113
6113	IF(JG.NE.'$')GO TO 7113
C  '$' IS FOR INVERSIONS IN 'NOTES'
	INVRT=0
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 JMOT=1,LCNT,3
	IF(JG.NE.LIST(JMOT))GO TO 6361
	VX1=0
	DO 40 M=JD+2,LEND
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
CCZZZ	IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JA
	JA=-1
	INP(K)=IBLA
	CALL SCANR
	JA=JC
140	JC=1
	KN=LIST(JMOT+1)
	M=LIST(JMOT+2)+1
	IF(RETRO)GO TO 640
	JC=M-1
	M=KN-1
	KN=JC
	JC=-1
	RETRO=-1.
640	IF(INVRT)GO TO 940
840	X=V(KN)
	V(I)=X+VX1
C  FINDS CENTER FOR INVERSION (+TRANSP.)
	I=I+1
	KN=KN+JC
	IF(V(KN-JC).NE.85.)GO TO 940
	V(I-1)=85.
	GO TO 840

940	Z=V(KN)
	IF(INVRT.EQ.0)GO TO 440
	IF(VX1.EQ.0)GO TO 540
C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(CODE.EQ.-33.)GO TO 440
	V(I)=Z*VX1
	GO TO 7361
440	IF(Z.EQ.85.)GO TO 540
	Y=0
	IF(INVRT.EQ.0)Y=(X-Z)*2.
	V(I)=Z+VX1+Y
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	INVRT=-1
	RB=V(I-1)
	DO 8361 L=JD,LEND
	JG=INP(L)
C   PUT IN NOV 25, 72
CCZZZ	IF(JG.EQ.ISEMI)GO TO 93612
	KN=L
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.')')IPRN=IPRN+1
	IF(JG.NE.ISEMI)GO TO 8361
	IAMP=-1
	GO TO 9361
8361	CONTINUE
C  ABOVE 4 LINES PUT IN 8/76. REPLACE C***********  ↓↓

CCZZZ8361	IF(JG.EQ.'*')IAMP=-1
C***********8361	IF(JG.EQ.ISEMI)IAMP=-1
C***********	MLX=LEND
C ↑↑↑↑↑↑↑ 6/75
C************	GO TO 93612

9361	MLX=L+1
	IF(L.GE.LEND)GO TO 93612
C************9361	MLX=L
C************	IF(L.EQ.LEND)GO TO 93612
C ↑↑↑↑↑↑↑ 6/75
C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
	IF(IAMP.NE.0)GO TO 797
	IF(QTS)GO TO 1773
C  GO BACK IF NOT END OF LINE
797	JZ=-1
93612	IF(IAMP.EQ.0)GO TO 93611
C   NOV 25, 72
	IF(QTS)GO TO 3013
	GO TO 2722
C  THESE ARE FOR "LIT" ITEMS
C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
CCZZZ93611	IF(JG.EQ.ISEMI)GO TO 7773
93611	IF(KN.EQ.LEND)GO TO 7773
	JZ=0
	IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
	GO TO 236
C  LAST TIME FOR QUOTES

C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
C   JUMPS TO END STRING OF QUOTES
6361	CONTINUE
	CALL ERR(LN)
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.EQ.'$')CALL ERR(LN)
C  FOUND $  BUT NO @!
	IF(N.NE.ID)GO TO 53611
	IF(ISUB.NE.1)GO TO 53611
	IF(INP(JD+1).NE.IF)GO TO 236
C  JUMP IF NOT DUTY FACTOR
	DF=DF-100.
	GO TO 43615
53611	IF(N.NE.ISS)GO TO 53612
	IF(INP(JD+1).NE.'U')GO TO 53612
	DF=DF-200
C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
	GO TO 43615
53612	IF(N.NE.IAA)GO TO 43611
C   FINDS 'ALL'.
	IF(INP(JD+1).NE.'L')GO TO 236
	ALL=-1.
	GO TO 43615
C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.

C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
C   BEFORE! QUAD (IF USED).
C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611	IF(N.NE.'Q')GO TO 4361
	IF(INP(JD+1).NE.'U')GO TO 4361
	QX=-13.
	DO 43612 N=JD,LEND
	J=INP(N)
	IF(J.EQ.IXX)QX=QX-1.
	IF(J.EQ.IF)QX=QX-2.
	IF(J.EQ.IBLA)GO TO 236
	IF(J.EQ.KSLA)GO TO 236
CCZZZ	IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43612	INP(N)=IBLA
4361	IF(N.NE.'I')GO TO 43613
	IF(ISUB.NE.4)GO TO 43613
C  -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
C  -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
C  THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
	L=-1
	N=INP(JD+1)
	IF(N.EQ.IE)L=L-1
	INVIS(LK)=L
43615	DO 43614 L=JD,LEND
	N=INP(L)
CC	IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
	IF(N.EQ.IBLA)GO TO 236
	IF(N.EQ.ISEMI)GO TO 236
CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614	INP(L)=IBLA
CC43613	IF(N.NE.KSLA)GO TO 636
43613	IF(N.NE.KSLA)GO TO 1336
CC	JZ=-1
	IF(JD.GE.LEND-1)JZ=0
C  SO IT WILL READ NEXT LINE.
CZZZZZZZZZZZZZZZ	INP(JD)=ISEMI
	GO TO 336
CCZZZ436	IF(INP(MLX).NE.IBLA)GO TO 336
CCZZZ	MLX=MLX+1
CCZZZ	GO TO 436
CC636	IF(JD.LT.LEND)GO TO 1336
CC	ICON=0
CC	GO TO 77731
CC	GO TO 7773
C  TO CONTINUE ON NEXT LINE.
CCZZZ636	IF(N.NE.ISEMI)GO TO 936
1336	IF(N.NE.ISEMI)GO TO 936
	IAMP=-1
CC	IF(ISUB.NE.1)IAMP=-1
336	MLX=JD+1
	IF(ISUB.GE.104)GO TO 104
	IF(ISUB.GT.3)GO TO 1899
   	GO TO (101,102,103),ISUB
C             PAR  MOV LIST  OTHERS
CCZZZ936	IF(N.NE.IDOT)GO TO 736
936	IF(N.NE.IDOT)GO TO 136
	L=INP(JD+1)
	DO 836 KL=1,10
836	IF(L.EQ.IDAT(KL))GO TO 236
	IF(CODE.EQ.-22.)INP(JD)=1
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
CCZZZ736	IF(N.NE.'*')GO TO 136
CCZZZ	IAMP=-1
CCZZZ	INP(JD)=IBLA
CCZZZ	GO TO 336
136	IF(N.NE.IQT)GO TO 236
	DO 1361 K=JD+1,LEND
	IF(INP(K).NE.IQT)GO TO 1361
	JD=K+1
	GO TO 975
C   SKIPS MATERIAL IN QUOTES
1361	CONTINUE
	CALL ERR(LN)
C   OPEN QUOTES
236	JD=JD+1
	IF(JD.LE.LEND)GO TO 975
	CALL ERR(1)
1899	CALL SCANR
CZZZZZZZ	ML=MLX
CZZZZZZZZZZZZZZZZZZZZZZZZZZ
	GO TO(1,2,3,4,5,6),ISUB
101	N=INP(ML)
	IZ=ML
	ML=ML+1
	IF(N.EQ.IBLA)GO TO 101
C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
	JA=-1
	IF(N.EQ.IPP)GO TO 1
	IF(N.EQ.IE)GO TO 2308
	IF(N.EQ.'R')CALL RUNIT
C   'RUN' MAY REPLACE 'END' FOR LAST INST.
	IF(N.EQ.ID)GO TO 7720
	CALL ERR(LN)
1	CALL SCANR
 	LPAR=VX1
	IJ=LPAR
	IF(QX.GE.0)GO TO 5703
	IJ=LPAR+4
C  SETS UP PARAM FOR QUAD CALL
	V(I)=IJ+LK*10000
	V(I+1)=2*ALL
C  TEST "ALL" FEATURE HERE!!!!!!!
C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
	V(I+2)=QX
	I=I+3
	QX=0.
5703	IAMP=0
	IF(IJ.LE.NP(LK))GO TO 897
	IF(IJ.LT.31)NP(LK)=IJ
897	IF(LPAR.EQ.32)LPAR=1
	V(I)=LPAR+LK*10000
C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
	IJ=I+1
	I=I+4
	ITMP=0
	CODE=0
	NFLG=1
	ML=IZ+M
C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
C  QU=QUADC  QUX=QUADX 
5702	ML=ML+1
CC	IF(ML.GT.72)GO TO 99
	N=INP(ML)
	IF(N.EQ.IBLA)GO TO 5702
	IF(N.EQ.',')GO TO 5702
	NL=INP(ML+1)
	JA=-1
	ISUB=0
	IF(N.EQ.IXX)GO TO 2703
	IF(N.EQ.'R')GO TO 6702
	IF(N.EQ.IF)GO TO 8702
	IF(N.EQ.IPP)GO TO 7006
	IF(N.NE.'C')GO TO 4005
	IF(NL.EQ.'U')GO TO 7006
C  FOR 'CUTOFF'
4005	JA=0
	IF(N.EQ.IEN)GO TO 6005
	IF(N.EQ.'M')GO TO 703
	IF(N.EQ.'L')GO TO 2720
	IF(N.EQ.ISS)GO TO 6703
	IF(N.EQ.ITT)GO TO 4018
	IF(N.EQ.IQT)GO TO 5720
	IF(N.EQ.ISEMI)GO TO 2018
C 7/75	IF(N.EQ.IPP)JA=-1
C  FOR ;P5  P3;
7006	CALL SCANR
	IF(ISUB.EQ.8)GO TO 8
	I=I+JJ
	V(IJ+1)=NNUM+DF
	IF(JJ.EQ.1)GO TO 4006
C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
	IF(NNUM.NE.-2)GO TO 5006
	IX=IJ+3
	DO 2006 K=2,JJ,3
2006  CALL RANR(VX,K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5006	IX=IJ+2
	DO 6006 K=1,JJ
6006	V(IX+K)=VX(K)
	IF(NL.EQ.'U')GO TO 8006
	V(IX+JJ-2)=1.
C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
	GO TO 3013
4006	IF(JA)VX1=VX1/100.+9999.
C  CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
	V(I-1)=VX1
	GO TO 3013
8006	V(IJ+1)=-19
C  FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
	GO TO 3013
6702	IF(NL.EQ.IE)GO TO 2703
C   JUMP IF "REP"
	IF(NL.EQ.ITT)GO TO 4018
C   JUMP IF "RTAP"
	CODE=-22
	IF(NL.EQ.'L')CODE=-46.0
C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
	IF(NL.NE.IEN)GO TO 1016
C   JUMP IF NOT "RNOTES"
	JA=0
C   FOR SCANR
	CODE=-36.
	GO TO 1016
6005	CODE=-33
	IF(NL.EQ.'A')GO TO 2720
C  NUMS, NOTES, NAMES.
	IF(NL.NE.'U')GO TO 1016
	CODE=-44.
1610	JA=-1
	GO TO 1016
8702	CODE=-35
	IF(NL.EQ.'U')GO TO 1016
	ML=ML+1
	CALL SCANR
7	V(IJ+1)=CODE+DF
	V(IJ+2)=1.
	IF(VX1.GT.15)CALL ERR(4) 
C TRAPS F NUMS >15.
	V(I)=VX1+85.
	GO TO 7703
C********  MOVE IS NEXT ***********
703	BW=V(IJ-2)
	IC=0
CC	DO 7031 K=ML+1,72
	DO 7031 K=ML+1,LEND
	LP=INP(K)
	IF(LP.EQ.KSLA)GO TO 8031
CC	IF(INP(K).EQ.ISEMI)GO TO 8031
	IF(LP.EQ.IPP)IC=1
C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
7031	IF(LP.EQ.IXX)IC=-1
C   IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
8031	I=I-1
	V(I)=0
	X=-9900.-BY
	IF(BY.EQ.0)X=-9900.-BG(LK)
   	IF(BW.EQ.X)GO TO 8005
	IF(BW.NE.-9900.-BY)GO TO 1102
	V(IJ-2)=X
	GO TO 8005
1102	V(IJ)=V(IJ-1)
	V(IJ-1)=X
	IJ=IJ+1
	I=I+1
8005	LP=IJ-1
	BW=-9900.-X
	ISUB=2
	IZ=-1
C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703	GO TO 1299
102	IF(IZ.LT.0)GO TO 2102
C  SKIPS NEXT FIRST TIME
	BW=V(ICT)+BW
	V(I)=-9900.-BW
	V(I+1)=V(LP)
	V(I+2)=(JJ+2)*ALL
	V(I+3)=CODE+DF
	I=I+4
	IZ=1
2102	IF(BW.LT.10000.)CALL BGSORT(BW)
C   ROUND-OFF NONSENSE
2	VX3=-9900.
	VX2=VX3 
	CALL SCANR
	IF(JJ.GT.0)GO TO 5102
	JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
	DO 6102 K=1,JJ
6102	VX(K)=VX(K+20)
	GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102	IF(JJ.EQ.4)CALL ERR(LN)
C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
	IF(VX3.NE.-9900.)GO TO 3102
	IF(VX2.NE.-9900.)GO TO 4102
	VX2=VX1
	VX1=10000.
4102	VX3=VX2
	JJ=3
C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102	IF(IZ.GE.0)GO TO 3006
	V(IJ)=(JJ+2)*ALL
C  WORD COUNT
	CODE=-55.
	IF(JJ.NE.3)CODE=-57.
	IF(NFLG)CODE=CODE-1.
	IF(IC)CODE=-59.
C  CODE=-56 OR -58 FOR NOTES.
	V(IJ+1)=CODE+DF
	IZ=0
3006	IF(NFLG.EQ.1)GO TO 5005
	CALL RANR(VX,2)
      IF(JJ.NE.3)CALL RANR(VX,4)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5005	IF(IC.LE.0)GO TO 3003
C NEXT FOR 'MOVP',  MOVE FROM PARAM TO PARAM.
	DO 1003 K=2,JJ
1003	VX(K)=VX(K)/100.0+9999.0
C  CHANGES PARAM NUMS TO MAGIC NUMS.
3003	ICT=I
	ILIT=JJ
C  SAVES FOR SLASH REPEAT FEATURE
  	IJ=IJ+1
	DO 1006 K=1,JJ
	VX(20+K)=VX(K)
C  SAVES FOR SLASH REPEAT FEATURE
1006	V(IJ+K)=VX(K)
	I=I+JJ  
	IJ=I+2
	IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
	V(I)=-9900.-BY
	GO TO 8703

7703	V(IJ)=4.*ALL
8703	I=I+1
	GO TO 4773
C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
6703	CODE=-12.
	IF(INP(ML+3).EQ.'L')CODE=-11.
	V(IJ)=2.*ALL
	V(IJ+1)=CODE+DF
	I=I-1
	GO TO 4773
4018	CNT(LK)=-9900.-BY
	P(LK)=V(I-4)
CC 6/74 COLGATE 	JREAD=3
CC 6/74 COLGATE	GO TO 4400
1444	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
	IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
	IF(J.EQ.'CONDU')GO TO 444
	IF(NL.NE.ITT)GO TO 2338
	CODE=-23.
	GO  TO 1016
2338	I=I-4
	GO TO 4773
3018	CNT(KZY)=-9900.
	GO TO 1444
444	P(KZY)=980000.
	GO TO 2308
C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C  'REP'
2703	ML=ML+1
	VX1=0
	VX2=0
	VX3=0
	IF(N.EQ.IXX)GO TO 2704
	INP(ML)=IBLA
	INP(ML+1)=IBLA
C  WIPES OUT 'EP' IN 'REP'
2704	CALL SCANR
 	V(IJ)=3.
	V(IJ+1)=-66.0
	IF(VX1.EQ.32.)VX1=1.
	IF(VX1.EQ.0)VX1=LPAR
	IF(VX2.EQ.0)VX2=LK-1
	V(IJ+2)=VX1+VX2*10000.
	KL=VX2
	IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
	IF(VX3.EQ.0)GO TO 4773
	L=VX3
	ML=LK+1
	DO 1018 KL=ML,L
	IF(LPAR.LE.NP(KL))GO TO 997
	IF(LPAR.LT.31)NP(KL)=LPAR
997	IF(DUR(KL))DUR(KL)=DUR(LK)
C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
	V(I)=V(I-4)+10000.
	V(I+1)=3.
	V(I+2)=-66.
	V(I+3)=V(I-1)
1018	I=I+4
	GO TO 4773

2018	IF(DF.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
	V(IJ+1)=-201.
	V(IJ+2)=1.
	V(IJ+3)=0
	GO TO 7703
20181	V(IJ)=3.
	V(IJ+1)=-66.
	V(IJ+2)=NW+LK*10000
	GO TO 4773
C  READS /P5  .3 "ABC" .7 "XYZ"/

8 	V(IJ+1)=-77.+DF
C  DF HAS SUBR CALL INFO
	I=I+1
	VX(JJ-1)=1
C  FOR RAND. SINGLE LITS.
	DO 3722 K=1,JJ,2
	V(I)=VX(K)
3722	I=I+1
	V(IJ+2)=JJ/2
	V(IJ+3)=I
	DO 4722 K=2,JJ,2
	KN=I
	I=I+1
	L=VX(K)
	DO 6722 KL=L,LEND
	IF(INP(KL).EQ.IQT)GO TO 4722
	IV(I)=INP(KL)
6722	I=I+1
4722	V(KN)=I-KN-1
	V(IJ)=(I-IJ)*ALL
	GO TO 4773
2720	QTS=0
	ISUB=104
	IF(NL.EQ.'A')ISUB=ISUB+1
	GO TO 1299

104	KL=0
	DO 6721 K=ML,LEND
	L=INP(K)
	IF(L.EQ.IBLA)GO TO 6721
	JC=K+1
	IF(L.EQ.IQT)GO TO 7721
	IF(L.EQ.KSLA)GO TO 7232
	IF(L.EQ.ISEMI)GO TO 7232
	IF(L.EQ.'%')INP(K)=KSLA
	IF(L.EQ.'?')INP(K)=ISEMI
	IF(L.EQ.'!')INP(K)=','
	IF(KL.EQ.0)KL=K
6721	CONTINUE
C  FOR REPEAT OF ITEM BY SLASH
C  KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
7232	IF(KL.EQ.0)GO TO 7233
	JC=KL
	ML=K+1
	JD=K-1
	NLIT=K-KL
	GO TO 8721

7233	DO 7230 KL=ILIT,ILIT+NLIT
	V(I)=V(KL)
7230	I=I+1
	GO TO 27222
7231	CONTINUE

5720	IAMP=-1
	JC=ML+1
C  FOR SINGLE 'LIT' ITEMS.
7721	DO 1722 KL=JC+1,LEND
	IF(INP(KL).NE.IQT)GO TO 1722
	JD=KL-1
	ML=KL+1
	NLIT=KL-JC
C   EXTENT OF LIT ITEM IS FOUND
	GO TO 8721
1722	CONTINUE
C  CAN'T USE SLASH FOR REPEAT AFTER @Q
8721	V(I)=NLIT
	ILIT=I
	DO 9721 K=JC,JD
C   PUTS ITEM IN "IV" ARRAY
	I=I+1
9721	IV(I)=INP(K)
	I=I+1
27222	IF(IAMP.EQ.0)GO TO 1299
2722	V(I)=999.
	QTS=-1.
	X=-88.
	IF(ISUB.EQ.105)X=-89.
C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
27221	V(IJ+1)=X+DF
	V(IJ)=(I-IJ+1)*ALL
	IJ=IJ+2
	V(IJ)=IJ+1
	I=I+1
	ISUB=1
	GO TO 1299

7720	V(I)=LK
	V(I+1)=3.
	V(I+2)=-67.
	ML=ML+4
	CALL SCANR
 	V(I+3)=VX1
	I=I+4
	L=VX1
	IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
	IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
	GO TO 4773
C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
142	FORMAT(I,15A5) 
1301	FORMAT(15A5) 
CCC2773	FORMAT(I,A5,72A1) 
CC2114  FORMAT(I,80A1)
300	FORMAT(I,3F,A1)
301	FORMAT(3F,A1)
6 	KB=KB+1
	IF(JED.GT.0)JED=0
	IF(J.EQ.'INSER')GO TO 1340
      OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
      GO TO 340   
1340	X=VX1
	IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
	OTH(KB,1)=X
	GO TO 1338
C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
C   - BEGIN LINE WITH  <,END WITH ; 
C   UP TO 75 CHARACTERS MAY BE TYPED.     
340      IF(VX3.NE.2)GO TO 1338 
	IF(ITYP.GE.0)GO TO 449
CC	JREAD=5
CC 6/74  COLGATE	GO TO 4400
	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
445	OTH(KB,3)=1.
	IF(LN.EQ.0)GO TO 447
	REREAD 300,K,OTH(KB,2)
	GO TO 1447
447	REREAD 301,OTH(KB,2)
1447	IF(JED)GO TO 2308
3445	TYPE TEDIT
	ACCEPT 77732,K
	IF(K.EQ.IG)JED=-1
	IF(J.EQ.'INSER')GO TO 3446
	IF(K.NE.'Y')GO TO 2308
	IF(JED)GO TO 2308
449	TYPE TPALN
	ACCEPT 301,OTH(KB,2)
	IF(JED)WRITE(21,301) OTH(KB,2)
	GO TO 2308

1338	IF(ITYP.GE.0)GO TO 1449
CC	JREAD=6
CC 6/74 COLGATE	GO TO 4400
	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
446	IF(LN.EQ.0)GO TO 448
	REREAD 142,K,(OTH(KB,JD),JD=2,16)    
	GO TO 1446
448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
1446	IF(JED)2446,3445,2446
3446	IF(K.NE.'Y')GO TO 2446
	IF(JED)GO TO 2446
1449	TYPE TPALN
	ACCEPT 1301,(OTH(KB,JD),JD=2,16)
	IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446	X=OTH(KB,2)
	IF(J.NE.'INSER')GO TO 971
	IF(VX3.EQ.0)GO TO 971
	IF(X.NE.'*')GO TO 6
971	IF(X.EQ.'*')KB=KB-1
C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C   LAST LINE HAS '*' IN COLUMN 1.
	GO TO 2308
C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C   BX=INST N. Y=NOTE N. Z=PARAM N. 
1106	KTMP=1
	TP=60.
	IAMP=0
	BW=BY
	ITMP=-1
	ISUB=5
	JA=-1
	GO TO 2016
3019	V(I)=990000.00
	V(I+1)=4.
	V(I+2)=VX1
	V(I+3)=VX2/TP
	V(I+4)=VX3/TP
	I=I+5
	BY=BW
C  SEPT 18, 70
	IF(VX1.EQ.0)GO TO 2308
	BW=BW+VX1
	V(I)=-9900.-BW
	I=I+1
	CALL BGSORT(BW)
9003	IF(IAMP)GO TO 4003
2016	VX3=0
	VX2=0
	GO TO 1299
5	IF(VX2.NE.0)GO TO 105
C  'TEMPO/120;'  OR  'TEMPO/1.5 72;'  IS OK.
	VX2=VX1
	VX1=0
105	IF(VX3.EQ.0)VX3=VX2
	IF(VX2.LT.11.)TP=1.
	IF(J.EQ.ITMPO)GO TO 3019
  	PCH(1,KTMP)=VX1
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX3
C   PCH(1)=TIME  (2)=MM1  (3)=MM2
	KTMP=KTMP+1
	IF(IAMP.EQ.0)GO TO 2016
4003	VX1=0
	IAMP=0
	VX2=VX3
	IF(J.EQ.ITMPO)GO TO 3019
	PCH(1,KTMP)=0
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX2
C   MM CAN BE FROM 11 UP  TEMPO FACTOR FROM 10 DOWN.  
C   UP TO 30 TEMPO CHANGES MAY BE MADE.   

1016      IA=I    
      IZ=1  
3100	V(I-2)=CODE+DF
      ISUB=3     
5016	IF(IAMP.GE.0)GO TO 1299
117	IF(IZ-2)3013,9004,9004
103	K=INP(ML)
	IF(K.EQ.ITT)GO TO 1106
	IF(K.EQ.KSLA)GO TO 1014
	IF(K.EQ.ISEMI)GO TO 1014
CZZZZZZZZZZZZ  CC  ZZZZZZZZZZZZ
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 103
3      IF(VX1.EQ.-99.)GO TO 4022
	IF(CODE.EQ.-22.)GO TO 2017
  	IF(CODE.LT.-23)GO TO 17
	IF(IZ/2*2.EQ.IZ)GO TO 17
C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017	IF(VX1.EQ.10000.)GO TO 17
      VX1=4./VX1
	IF(JJ.NE.1)GO TO 2014
	V(I)=VX1
	GO TO 114

1217	IF(VX1.EQ.10000.)GO TO 114
C    FOR "FINE" IN LIST
      V(I+1)=VX2
      IF(CODE.EQ.-36.)CALL RANR(V,I)
2217	I=I+1
C  SETS UP STRING OF RAND SELECTIONS
	GO TO 114
3217	V(I)=V(I-2)
	V(I+1)=RB
C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
	GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******

2014	DO 9006 L=2,JJ
	IF(VX(L).EQ.0)GO TO 17
9006	VX1=4./VX(L)+VX1
	JJ=1
17	V(I)=VX1
	IF(CODE.EQ.-46.)GO TO 1217
	IF(CODE.EQ.-36.)GO TO 1217
	IF(CODE.NE.-35)GO TO 972
	IF(VX1.GT.15)CALL ERR(4)
C  FINDS F NUM.>15!
C  JUMP IF STRING OF RAND SELECS.
972	IF(JJ.EQ.1)GO TO 114
	L=VX(JJ)-1
	X=V(I)
	NL=I+1
	I=L+I
	DO 1017 K=NL,I
1017	V(K)=X
C   ADDS UP TOTAL   OF NOTES IN SEQ.
	IZ=IZ+L
	GO TO 114
1014	IF(CODE.EQ.-46.)GO TO 3217
	IF(CODE.EQ.-36.)GO TO 3217
	V(I)=RB
C   RB SAVES IT FOR SLASH REPEAT
114      RB=V(I)     
      I=I+1 
      IZ=IZ+1     
      GO TO 5016    
4022      JC=VX2+.3
      JD=VX3-.5
	IF(JJ.EQ.2)JD=1
C********* MAY 19,71   ----MANY LINES ABOVE.
      IZ=IZ+JC*JD 
C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
      DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
2005  V(L)=V(L-JC)
1005      I=I+JC  
	RB=V(NL)
C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
      GO TO 5016  

9004	IF(ITMP.EQ.0)GO TO 3013
	IZ=IZ-1
C***** JAN. 1974
      KA=1  
      IC=1  
      K=0   
	J=1
      Z=0   
      RC=0  
9007	Y=PCH(3,IC)/TP
	X=PCH(2,IC)/TP
      Z=PCH(1,IC) 
	CALL SQYY(YY,X,Y,Z)
	XT(1)=X
      PR=RA 
C75      RD=1  
C75      RB=0  
      ZZ=Z  
      CALL ACCEL
      IF(K.EQ.IZ)GO TO 3013
	IF(RA.NE.10000.)GO TO 9007     
C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
3013	X=I-IJ
	V(IJ+2)=X-3.
	V(IJ)=X*ALL
	IF(CODE.NE.-35)GO TO 4773
	M=IJ+3
C   SETS NUMBERS FOR FUNCS.
	DO 313 K=M,I-1
313	IF(V(K).LT.85.)V(K)=V(K)+85.
	GO TO 4773

	END